(load "compiler.scm")

(define nl (list->string (list #\newline)))
(define tb (list->string (list #\tab)))

(define ^^label
  (lambda (name)
    (let ((n 0))
      (lambda ()
        (set! n (+ n 1))
        (string-append name
                       (number->string n))))))

;(define ^label-if3else (^^label "Lif3else"))
;(define ^label-if3exit (^^label "Lif3exit"))
;(define nl (list->string (list #\newline)))
(define unary-function-generator
  (lambda (code-label comments1 comments2 extra-code symbol-string triple)
    (let ((part-code 
           (string-append 
            code-label ":" comments1 nl 
            "if (stack[fp-3] != 1" nl
            tb "goto Error-Wrong-Number-Of-Parameters;" nl
            "r1 = stack[fp-4];" nl
            extra-code
            "goto *pop();"))
          (part-init
           (string-append 
            comments2
            "static struct SOBClosure tmp_primitive = {SCHEME_CLOSURE,(SchemeObject **)01012100, &&" code-label "};" nl
            "r1 = (void *)getSymbol(\"" symbol-string "\", SymbolTableHead);" nl
            "SYM_ISDEF(r1) = 1;" nl
            "SYM_VALUE(r1) = &tmp_primitive;" nl))) 
      (append-triple triple "" part-init part-code))))


(define unary-function-generator
  (lambda (code-label comments1 comments2 extra-code symbol-string triple)
    (let ((part-code 
           (string-append 
            code-label ":" comments1 nl 
            "if (stack[fp-3] != 1)" nl
            tb "goto Error_Wrong_Number_Of_Parameters;" nl
            "r1 = stack[fp-4];" nl
            extra-code
            "goto *pop();" nl
            "Error_Wrong_Number_Of_Parameters:;" nl
            "Error_Pair_Type_Mismatched:;" nl
            ))
          (part-init
           (string-append 
            comments2
            "static struct SOBClosure tmp_primitive = {SCHEME_CLOSURE,(SchemeObject **)01012100, &&" code-label "};" nl
            "r1 = (void *)getSymbol(\"" symbol-string "\", SymbolTableHead);" nl
            "SYM_ISDEF(r1) = 1;" nl
            "SYM_VALUE(r1) = &tmp_primitive;" nl))) 
      (append-triple triple "" part-init part-code))))

(define car-code (unary-function-generator "Lcar" 
                                           " // CAR code"
                                           (string-append nl "// CAR: runtime binding" nl)
                                           (string-append
                                            "if (IS_SOB_PAIR(r1))" nl
                                            tb "goto Error_Pair_Type_Mismatched;" nl
                                            "r_res = SOB_PAIR_CAR(r1);" nl)
                                           "car"  '("" "" "")))  


(define delete-if-exist
  (lambda (file)
    (if (file-exists? file)
        (delete-file file))))
(define write->file
  (lambda (file text) 
    (let ((port (open-output-file file)))
      (display text port)
      (close-output-port port))))



(delete-if-exist "src/code.c")
(write->file "src/code.c" (string-append 
                           "#include \"../h/code.h\"" nl
                           nl
                           "void schemeCompiledFunction(){" nl
                           "" nl (get-triple car-code 'def) nl
                           "" nl (get-triple car-code 'init) nl
                           "" nl (get-triple car-code 'code) nl
                           "}" nl
                           ))